{-
    pHaskell Translator v0.1 
    Copyright (C) 2009  Ruben Marcelo Caro 

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
module LambdaTypes where
 
data LambdaType = LtBool | LtInt | LtArrow LambdaType LambdaType | LUserDef String |LtUnknown
						deriving (Eq,Show)
						
--elemento para formar un contexto
type LTypeDefinition = (String, LambdaType)   

type LProgram          = [LDefinition]
type LUserDefinedTypes = [(String, [LConstructorType])]

data LConstructorType = LConstructorType String [LambdaType]
							deriving (Eq,Show)

							
data LDefinition = LDefinition String LExp LProgram   --LProgram son las definiciones locales
					deriving (Eq,Show)	
data LExp = 
       LApp LExp LExp
     | LTypeConstructor String [LExp]
     | LInteger String 
	 | LVariable String
	 | LBoolean String
	 | LLambda LExp LambdaType LExp  --nombre de la var, tipo, exprecion, definiciones locales
	 | LIf     LExp LExp LExp        --if e then e' else e''
	 | LIfOnly LExp LExp             --if e then e' else e''  
        deriving (Eq,Show)              

--types utils
lsourceType ( LtArrow t1 t2 ) = t1
ldestinationType ( LtArrow t1 t2 ) = t2

getAllConstructorsName::LUserDefinedTypes->[String]
getAllConstructorsName ldefTypes =  concat (map getName ldefTypes)
									where
										getName (n, ([(LConstructorType name _)]))  = [name]
										getName (n, ((LConstructorType name _):xs)) = name:(getName (n, xs))



--prety printer
--TODO: falta prety printer de los typeDef
lambdaPretyPrinterProgram (program, typesDef)  = concat (map lambdaPretyPrinter program) 

lambdaPretyPrinter (LDefinition funcName e locals) = funcName ++" = " ++ (lambdaPretyPrinterExp e) ++"\n["++(lambdaPretyPrinterProgram (locals, []))++"]\n"
lambdaPretyPrinterExp (LApp e e') = (lambdaPretyPrinterExp e)++" ("++(lambdaPretyPrinterExp e') ++ ")"
lambdaPretyPrinterExp (LInteger number) = number 
lambdaPretyPrinterExp (LVariable var)   = "Variable("++var++")"
lambdaPretyPrinterExp (LBoolean bool)   = "Bool("++bool++")"
lambdaPretyPrinterExp (LLambda e1 t e ) = "(\\"++(lambdaPretyPrinterExp e1)++":("++(lambdaPretyPrinterType t)++") -> "++(lambdaPretyPrinterExp e)++")" 
lambdaPretyPrinterExp (LIf e e' e'') = "(if " ++ (lambdaPretyPrinterExp e)++" then "++(lambdaPretyPrinterExp e')++" else ("++(lambdaPretyPrinterExp e'')++ " endif)"
lambdaPretyPrinterExp (LIfOnly e e') = "(if " ++ (lambdaPretyPrinterExp e)++" then "++(lambdaPretyPrinterExp e')++ " endif)"
lambdaPretyPrinterExp (LTypeConstructor name exprs) = name++"<"++ concat (map lambdaPretyPrinterExp exprs) ++">"
lambdaPretyPrinterType LtBool          = "bool"
lambdaPretyPrinterType LtInt           = "int"
lambdaPretyPrinterType (LtArrow t1 t2) = (lambdaPretyPrinterType t1) ++ "->" ++ (lambdaPretyPrinterType t2)
lambdaPretyPrinterType (LUserDef t)    =  t
lambdaPretyPrinterType LtUnknown       =  "unknown"
 
